home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / chasm.lqr / CHASM.LBR / COM2DATA.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  2011-01-29  |  4.4 KB  |  125 lines
  1. 1000  '******************************************
  2. 1010  '* PROGRAM COM2DATA  Version 1.0          *
  3. 1020  '*                                        *
  4. 1030  '* (1983) by David Whitman                *
  5. 1040  '*                                        *
  6. 1050  '* Reads a .COM format file and produces  *
  7. 1060  '* a file of DATA statements, which may   *
  8. 1070  '* be merged into a BASIC program.        *
  9. 1080  '******************************************
  10. 1090  '
  11. 1095  'print title page
  12. 1100    GOSUB 5000
  13. 1110  '
  14. 1120  'set up error trapping, declare all integers
  15. 1130   ON ERROR GOTO 6000: DEFINT A-Z
  16. 1140  '
  17. 1150  'open input file
  18. 1160    LOCATE 1,1: GOSUB 4000: INPUT "Name of COM file? [.com] ",C$
  19. 1170    IF C$ = "" THEN BEEP: GOTO 1160
  20. 1180    'if no extension, add default
  21. 1190      IF INSTR(C$,".") = 0                                                               THEN IN$ = C$ + ".com"                                                          ELSE IN$ = C$: C$ = LEFT$(C$,INSTR(C$,".")-1)
  22. 1191    'test if file exists
  23. 1192      OPEN IN$ FOR INPUT AS #1: CLOSE #1
  24. 1193    'and open it
  25. 1200      OPEN IN$ AS #1 LEN=1: FIELD #1, 1 AS BYTE$
  26. 1210  '
  27. 1220  'open output file
  28. 1230    LOCATE 3,1: GOSUB 4000: PRINT "Name for DATA file? ["; C$; ".dat] ";
  29. 1240    INPUT "", D$
  30. 1250    'default to input name with extension .dat
  31. 1260       IF D$ = "" THEN D$ = C$ + ".dat"
  32. 1270    OPEN D$ FOR OUTPUT AS #2
  33. 1280  '
  34. 1290  'get starting line number
  35. 1291  GOSUB 4000
  36. 1300   LOCATE 5,1: INPUT "Starting line number? [1000] ", L$
  37. 1310   'scan for non-numeric digits, bitch if so
  38. 1320   FOR I = 1 TO LEN(L$)
  39. 1330     N$ = MID$(L$,I,1)
  40. 1340     IF INSTR("0123456789", N$) = 0                                                     THEN LOCATE 5,1: BEEP: PRINT SPACE$(79): GOTO 1300
  41. 1350     NEXT I
  42. 1360   IF L$ = ""                                                                        THEN LINENUM = 1000                                                             ELSE LINENUM = VAL(L$)
  43. 1370   IF LINENUM <= 0 THEN LOCATE 5,1: BEEP: PRINT SPACE$(79): GOTO 1300
  44. 1380  '
  45. 1390  'set display width and number of data entrys per line
  46. 1400  'users with 40 column displays, edit appropriately
  47. 1410    WIDTH.OF.DISPLAY = 80: ENTRYS.PER.LINE = 10
  48. 1430  '
  49. 1440  'whew! now do it.
  50. 1444  CLS: GOSUB 4000: GOSUB 4000
  51. 1445  LOCATE 10, (WIDTH.OF.DISPLAY-7)/2: COLOR 16,7: PRINT"*WORKING*": COLOR 7,0
  52. 1450  ENTRYS.USED = 0: NUMBYTES = 0
  53. 1455  GET 1
  54. 1460  WHILE NOT EOF(1)
  55. 1490    'and send it to output file
  56. 1500     GOSUB 1550
  57. 1506     GET 1
  58. 1510    WEND
  59. 1520  '
  60. 1530  'Clean up
  61. 1535  'if any data not written yet, lop off trailing comma and write it.
  62. 1540   IF ENTRYS.USED > 0 THEN PRINT#2, LEFT$(BUFFER$,LEN(BUFFER$)-1)
  63. 1543  FOR I = 1 TO 3: SOUND 500*I,3: NEXT: SOUND 550,5: SOUND 800,3
  64. 1544  CLS
  65. 1545  SYSTEM
  66. 1550  '******************************************
  67. 1560  '* SUBROUTINE OUTPUT                      *
  68. 1570  '*                                        *
  69. 1580  '* Builds up DATA statements in buffer.   *
  70. 1590  '* Dumps buffer to output file when full. *
  71. 1600  '******************************************
  72. 1610  '
  73. 1620  'set up if necessary
  74. 1630   IF ENTRYS.USED = 0                                                                 THEN BUFFER$ = STR$(LINENUM) + " DATA"
  75. 1640  '
  76. 1650  'add new value to buffer
  77. 1660   H$ = RIGHT$("0" + HEX$(ASC(BYTE$)),2)
  78. 1670   BUFFER$ = BUFFER$ + " &H" + H$
  79. 1680  '
  80. 1690  'Is the line full yet?  Dump if so.
  81. 1700   ENTRYS.USED = ENTRYS.USED + 1
  82. 1710   IF ENTRYS.USED < ENTRYS.PER.LINE THEN BUFFER$ = BUFFER$ + ",": GOTO 1750
  83. 1720      PRINT#2, BUFFER$
  84. 1730      ENTRYS.USED = 0
  85. 1740      LINENUM = LINENUM + 10
  86. 1750   RETURN
  87. 1760  ON ERROR GOTO 0
  88. 4000  'one liner to make noise #1
  89. 4010  FOR I = 1 TO 3: SOUND 1000*I,1: NEXT I: RETURN
  90. 5000  '**********************
  91. 5010  '* SUBROUTINE TITLE   *
  92. 5020  '* Prints title page. *
  93. 5030  '**********************
  94. 5040  '
  95. 5050  SCREEN 0,0,0: WIDTH 80: KEY OFF: CLS: LOCATE 6,1,0
  96. 5060  PRINT TAB(18) "KEY";STRING$(45,"THEN");"CLOSE"
  97. 5070  PRINT TAB(18) "OPEN                                             OPEN"
  98. 5080  PRINT TAB(18) "OPEN          COM2DATA   version 1.0             OPEN"
  99. 5090  PRINT TAB(18) "OPEN                                             OPEN"
  100. 5091  PRINT TAB(18) "OPEN          (1983) by David Whitman            OPEN"
  101. 5094  PRINT TAB(18) "OPEN                                             OPEN"
  102. 5097  PRINT TAB(18) "OPEN  Machine language file conversion utility.  OPEN"
  103. 5160  PRINT TAB(18) "OPEN                                             OPEN"
  104. 5170  PRINT TAB(18) "SCREEN";STRING$(45,"THEN");"LOAD"
  105. 5180  LOCATE 23,27: PRINT "Hit any key to continue..."
  106. 5185  GOSUB 4000 'noise #1
  107. 5190  I$ = INKEY$: IF I$ = "" THEN 5190
  108. 5200  CLS
  109. 5210  RETURN
  110. 6000  '*****************
  111. 6010  '* Error handler *
  112. 6020  '*****************
  113. 6030  '
  114. 6040  IF ERR <> 53 THEN 6100
  115. 6050     COLOR 0,7: BEEP: LOCATE 2,1
  116. 6060     PRINT IN$; " not found.  Press Esc to exit, anything else to continue."
  117. 6070     IN$ = INKEY$: IF IN$ = "" THEN 6070
  118. 6075     IF IN$ = CHR$(27) THEN SYSTEM
  119. 6080     LOCATE ,1: COLOR 7,0: PRINT SPACE$(79)
  120. 6085     LOCATE 1,1: PRINT SPACE$(79): LOCATE ,1: RESUME 1160
  121. 6090  '
  122. 6100  IF ERR <> 6 OR ERL <> 1360 THEN 6200
  123. 6110     BEEP: LOCATE 5,1: PRINT SPACE$(79): LOCATE ,1: RESUME 1300
  124. 6200  ON ERROR GOTO 0
  125.